home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 21 / AACD 21.iso / AACD / Utilities / Ghostscript / src / iscanbin.c < prev    next >
Encoding:
C/C++ Source or Header  |  2001-01-01  |  23.0 KB  |  795 lines
  1. /* Copyright (C) 1989, 2000 Aladdin Enterprises.  All rights reserved.
  2.   
  3.   This file is part of AFPL Ghostscript.
  4.   
  5.   AFPL Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author or
  6.   distributor accepts any responsibility for the consequences of using it, or
  7.   for whether it serves any particular purpose or works at all, unless he or
  8.   she says so in writing.  Refer to the Aladdin Free Public License (the
  9.   "License") for full details.
  10.   
  11.   Every copy of AFPL Ghostscript must include a copy of the License, normally
  12.   in a plain ASCII text file named PUBLIC.  The License grants you the right
  13.   to copy, modify and redistribute AFPL Ghostscript, but only under certain
  14.   conditions described in the License.  Among other things, the License
  15.   requires that the copyright notice and this notice be preserved on all
  16.   copies.
  17. */
  18.  
  19. /*$Id: iscanbin.c,v 1.5 2000/09/19 19:00:46 lpd Exp $ */
  20. /* Ghostscript binary token scanner and writer */
  21. #include "math_.h"
  22. #include "memory_.h"
  23. #include "ghost.h"
  24. #include "gsutil.h"
  25. #include "gxalloc.h"        /* for names_array in allocator */
  26. #include "stream.h"
  27. #include "strimpl.h"        /* for sfilter.h */
  28. #include "sfilter.h"        /* for iscan.h */
  29. #include "errors.h"
  30. #include "ialloc.h"
  31. #include "iddict.h"
  32. #include "dstack.h"        /* for immediately evaluated names */
  33. #include "ostack.h"        /* must precede iscan.h */
  34. #include "iname.h"
  35. #include "iscan.h"        /* for scan_Refill */
  36. #include "iscanbin.h"
  37. #include "iutil.h"
  38. #include "ivmspace.h"
  39. #include "store.h"
  40. #include "btoken.h"
  41. #include "ibnum.h"
  42.  
  43. /* Define the binary token types. */
  44. typedef enum {
  45.     BT_SEQ = 128,        /* binary object sequence: */
  46.     BT_SEQ_IEEE_MSB = 128,    /* IEEE floats, big-endian */
  47.     BT_SEQ_IEEE_LSB = 129,    /* IEEE float, little-endian */
  48.     BT_SEQ_NATIVE_MSB = 130,    /* native floats, big-endian */
  49.     BT_SEQ_NATIVE_LSB = 131,    /* native floats, little-endian */
  50.     BT_INT32_MSB = 132,
  51.     BT_INT32_LSB = 133,
  52.     BT_INT16_MSB = 134,
  53.     BT_INT16_LSB = 135,
  54.     BT_INT8 = 136,
  55.     BT_FIXED = 137,
  56.     BT_FLOAT_IEEE_MSB = 138,
  57.     BT_FLOAT_IEEE_LSB = 139,
  58.     BT_FLOAT_NATIVE = 140,
  59.     BT_BOOLEAN = 141,
  60.     BT_STRING_256 = 142,
  61.     BT_STRING_64K_MSB = 143,
  62.     BT_STRING_64K_LSB = 144,
  63.     BT_LITNAME_SYSTEM = 145,
  64.     BT_EXECNAME_SYSTEM = 146,
  65.     BT_LITNAME_USER = 147,
  66.     BT_EXECNAME_USER = 148,
  67.     BT_NUM_ARRAY = 149
  68. } bin_token_type_t;
  69.  
  70. #define MIN_BIN_TOKEN_TYPE 128
  71. #define MAX_BIN_TOKEN_TYPE 159
  72. #define NUM_BIN_TOKEN_TYPES (MAX_BIN_TOKEN_TYPE - MIN_BIN_TOKEN_TYPE + 1)
  73.  
  74. /* Define the number of required initial bytes for binary tokens. */
  75. private const byte bin_token_bytes[NUM_BIN_TOKEN_TYPES] =
  76. {
  77.     4, 4, 4, 4, 5, 5, 3, 3, 2, 2, 5, 5, 5,
  78.     2, 2, 3, 3, 2, 2, 2, 2, 4,
  79.     1, 1, 1, 1, 1, 1, 1, 1, 1, 1    /* undefined */
  80. };
  81.  
  82. /* Define the number formats for those binary tokens that need them. */
  83. private const byte bin_token_num_formats[NUM_BIN_TOKEN_TYPES] =
  84. {
  85.     num_msb + num_float_IEEE,    /* BT_SEQ_IEEE_MSB */
  86.     num_lsb + num_float_IEEE,    /* BT_SEQ_IEEE_LSB */
  87.     num_msb + num_float_native,    /* BT_SEQ_NATIVE_MSB */
  88.     num_lsb + num_float_native,    /* BT_SEQ_NATIVE_LSB */
  89.     num_msb + num_int32,    /* BT_INT32_MSB */
  90.     num_lsb + num_int32,    /* BT_INT32_LSB */
  91.     num_msb + num_int16,    /* BT_INT16_MSB */
  92.     num_lsb + num_int16,    /* BT_INT16_LSB */
  93.     0,                /* BT_INT8, not used */
  94.     0,                /* BT_FIXED, not used */
  95.     num_msb + num_float_IEEE,    /* BT_FLOAT_IEEE_MSB */
  96.     num_lsb + num_float_IEEE,    /* BT_FLOAT_IEEE_LSB */
  97.     num_float_native,        /* BT_FLOAT_NATIVE */
  98.     0,                /* BT_BOOLEAN, not used */
  99.     0,                /* BT_STRING_256, not used */
  100.     num_msb,            /* BT_STRING_64K_MSB */
  101.     num_lsb            /* BT_STRING_64K_LSB */
  102.     /* rest not used */
  103. };
  104.  
  105. /* Binary object sequence element types */
  106. typedef enum {
  107.     BS_TYPE_NULL = 0,
  108.     BS_TYPE_INTEGER = 1,
  109.     BS_TYPE_REAL = 2,
  110.     BS_TYPE_NAME = 3,
  111.     BS_TYPE_BOOLEAN = 4,
  112.     BS_TYPE_STRING = 5,
  113.     BS_TYPE_EVAL_NAME = 6,
  114.     BS_TYPE_ARRAY = 9,
  115.     BS_TYPE_MARK = 10,
  116.     /*
  117.      * We extend the PostScript language definition by allowing
  118.      * dictionaries in binary object sequences.  The data for
  119.      * a dictionary is like that for an array, with the following
  120.      * changes:
  121.      *      - If the size is an even number, the value is the index of
  122.      * the first of a series of alternating keys and values.
  123.      *      - If the size is 1, the value is the index of another
  124.      * object (which must also be a dictionary, and must not have
  125.      * size = 1); this object represents the same object as that one.
  126.      */
  127.     BS_TYPE_DICTIONARY = 15
  128. } bin_seq_type_t;
  129.  
  130. #define BS_EXECUTABLE 128
  131. #define SIZEOF_BIN_SEQ_OBJ ((uint)8)
  132.  
  133. /* Forward references */
  134. private int scan_bin_get_name(P3(const ref *, int, ref *));
  135. private int scan_bin_num_array_continue(P4(i_ctx_t *, stream *, ref *, scanner_state *));
  136. private int scan_bin_string_continue(P4(i_ctx_t *, stream *, ref *, scanner_state *));
  137. private int scan_bos_continue(P4(i_ctx_t *, stream *, ref *, scanner_state *));
  138. private byte *scan_bos_resize(P4(i_ctx_t *, scanner_state *, uint, uint));
  139. private int scan_bos_string_continue(P4(i_ctx_t *, stream *, ref *, scanner_state *));
  140.  
  141. /* Scan a binary token.  Called from the main scanner */
  142. /* when it encounters an ASCII code 128-159, */
  143. /* if binary tokens are being recognized (object format != 0). */
  144. int
  145. scan_binary_token(i_ctx_t *i_ctx_p, stream *s, ref *pref,
  146.           scanner_state *pstate)
  147. {
  148.     scan_binary_state *const pbs = &pstate->s_ss.binary;
  149.  
  150.     s_declare_inline(s, p, rlimit);
  151.     int num_format, code;
  152.     uint arg;
  153.     uint wanted;
  154.     uint rcnt;
  155.  
  156.     s_begin_inline(s, p, rlimit);
  157.     wanted = bin_token_bytes[*p - MIN_BIN_TOKEN_TYPE] - 1;
  158.     rcnt = rlimit - p;
  159.     if (rcnt < wanted) {
  160.     s_end_inline(s, p - 1, rlimit);
  161.     pstate->s_scan_type = scanning_none;
  162.     return scan_Refill;
  163.     }
  164.     num_format = bin_token_num_formats[*p - MIN_BIN_TOKEN_TYPE];
  165.     switch (*p) {
  166.     case BT_SEQ_IEEE_MSB:
  167.     case BT_SEQ_IEEE_LSB:
  168.     case BT_SEQ_NATIVE_MSB:
  169.     case BT_SEQ_NATIVE_LSB:{
  170.         uint top_size = p[1];
  171.         uint hsize, size;
  172.  
  173.         pbs->num_format = num_format;
  174.         if (top_size == 0) {
  175.             /* Extended header (2-byte array size, 4-byte length) */
  176.             ulong lsize;
  177.  
  178.             if (rcnt < 7) {
  179.             s_end_inline(s, p - 1, rlimit);
  180.             pstate->s_scan_type = scanning_none;
  181.             return scan_Refill;
  182.             }
  183.             if (p[1] != 0) /* reserved, must be 0 */
  184.             return_error(e_syntaxerror);
  185.             top_size = sdecodeushort(p + 2, num_format);
  186.             lsize = sdecodelong(p + 4, num_format);
  187.             if ((size = lsize) != lsize)
  188.             return_error(e_limitcheck);
  189.             hsize = 8;
  190.         } else {
  191.             /* Normal header (1-byte array size, 2-byte length). */
  192.             /* We already checked rcnt >= 3. */
  193.             size = sdecodeushort(p + 2, num_format);
  194.             hsize = 4;
  195.         }
  196.         if (size < hsize)
  197.             return_error(e_syntaxerror);
  198.         /* Preallocate an array large enough for the worst case, */
  199.         /* namely, all objects and no strings. */
  200.         code = ialloc_ref_array(&pbs->bin_array,
  201.                    a_all + a_executable, size / sizeof(ref),
  202.                     "binary object sequence(objects)");
  203.         if (code < 0)
  204.             return code;
  205.         p += hsize - 1;
  206.         size -= hsize;
  207.         s_end_inline(s, p, rlimit);
  208.         pbs->max_array_index = pbs->top_size = top_size;
  209.         pbs->min_string_index = pbs->size = size;
  210.         pbs->index = 0;
  211.         pstate->s_da.is_dynamic = false;
  212.         pstate->s_da.base = pstate->s_da.next =
  213.             pstate->s_da.limit = pstate->s_da.buf;
  214.         code = scan_bos_continue(i_ctx_p, s, pref, pstate);
  215.         if (code == scan_Refill || code < 0) {
  216.             /* Clean up array for GC. */
  217.             uint index = pbs->index;
  218.  
  219.             refset_null(pbs->bin_array.value.refs + index,
  220.                 r_size(&pbs->bin_array) - index);
  221.         }
  222.         return code;
  223.         }
  224.     case BT_INT8:
  225.         make_int(pref, (p[1] ^ 128) - 128);
  226.         s_end_inline(s, p + 1, rlimit);
  227.         return 0;
  228.     case BT_FIXED:
  229.         num_format = p[1];
  230.         if (!num_is_valid(num_format))
  231.         return_error(e_syntaxerror);
  232.         wanted = 1 + encoded_number_bytes(num_format);
  233.         if (rcnt < wanted) {
  234.         s_end_inline(s, p - 1, rlimit);
  235.         pstate->s_scan_type = scanning_none;
  236.         return scan_Refill;
  237.         }
  238.         code = sdecode_number(p + 2, num_format, pref);
  239.         goto rnum;
  240.     case BT_INT32_MSB:
  241.     case BT_INT32_LSB:
  242.     case BT_INT16_MSB:
  243.     case BT_INT16_LSB:
  244.     case BT_FLOAT_IEEE_MSB:
  245.     case BT_FLOAT_IEEE_LSB:
  246.     case BT_FLOAT_NATIVE:
  247.         code = sdecode_number(p + 1, num_format, pref);
  248.       rnum:
  249.         switch (code) {
  250.         case t_integer:
  251.         case t_real:
  252.             r_set_type(pref, code);
  253.             break;
  254.         case t_null:
  255.             return_error(e_syntaxerror);
  256.         default:
  257.             return code;
  258.         }
  259.         s_end_inline(s, p + wanted, rlimit);
  260.         return 0;
  261.     case BT_BOOLEAN:
  262.         arg = p[1];
  263.         if (arg & ~1)
  264.         return_error(e_syntaxerror);
  265.         make_bool(pref, arg);
  266.         s_end_inline(s, p + 1, rlimit);
  267.         return 0;
  268.     case BT_STRING_256:
  269.         arg = *++p;
  270.         goto str;
  271.     case BT_STRING_64K_MSB:
  272.     case BT_STRING_64K_LSB:
  273.         arg = sdecodeushort(p + 1, num_format);
  274.         p += 2;
  275.       str:
  276.         if (s->foreign && rlimit - p >= arg) {
  277.         /*
  278.          * Reference the string directly in the buffer.  It is
  279.          * marked writable for consistency with the non-direct
  280.          * case, but since the "buffer" may be data compiled into
  281.          * the executable, it is probably actually read-only.
  282.          */
  283.         s_end_inline(s, p, rlimit);
  284.         make_string(pref, a_all | avm_foreign, arg,
  285.                 (byte *)sbufptr(s));
  286.         sbufskip(s, arg);
  287.         return 0;
  288.         } else {
  289.         byte *str = ialloc_string(arg, "string token");
  290.  
  291.         if (str == 0)
  292.             return_error(e_VMerror);
  293.         s_end_inline(s, p, rlimit);
  294.         pstate->s_da.base = pstate->s_da.next = str;
  295.         pstate->s_da.limit = str + arg;
  296.         code = scan_bin_string_continue(i_ctx_p, s, pref, pstate);
  297.         if (code == scan_Refill || code < 0) {
  298.             pstate->s_da.is_dynamic = true;
  299.             make_null(&pbs->bin_array);        /* clean up for GC */
  300.             pbs->cont = scan_bin_string_continue;
  301.         }
  302.         return code;
  303.         }
  304.     case BT_LITNAME_SYSTEM:
  305.         code = scan_bin_get_name(system_names_p, p[1], pref);
  306.         goto lname;
  307.     case BT_EXECNAME_SYSTEM:
  308.         code = scan_bin_get_name(system_names_p, p[1], pref);
  309.         goto xname;
  310.     case BT_LITNAME_USER:
  311.         code = scan_bin_get_name(user_names_p, p[1], pref);
  312.       lname:
  313.         if (code < 0)
  314.         return code;
  315.         if (!r_has_type(pref, t_name))
  316.         return_error(e_undefined);
  317.         s_end_inline(s, p + 1, rlimit);
  318.         return 0;
  319.     case BT_EXECNAME_USER:
  320.         code = scan_bin_get_name(user_names_p, p[1], pref);
  321.       xname:
  322.         if (code < 0)
  323.         return code;
  324.         if (!r_has_type(pref, t_name))
  325.         return_error(e_undefined);
  326.         r_set_attrs(pref, a_executable);
  327.         s_end_inline(s, p + 1, rlimit);
  328.         return 0;
  329.     case BT_NUM_ARRAY:
  330.         num_format = p[1];
  331.         if (!num_is_valid(num_format))
  332.         return_error(e_syntaxerror);
  333.         arg = sdecodeushort(p + 2, num_format);
  334.         code = ialloc_ref_array(&pbs->bin_array, a_all, arg,
  335.                     "number array token");
  336.         if (code < 0)
  337.         return code;
  338.         pbs->num_format = num_format;
  339.         pbs->index = 0;
  340.         p += 3;
  341.         s_end_inline(s, p, rlimit);
  342.         code = scan_bin_num_array_continue(i_ctx_p, s, pref, pstate);
  343.         if (code == scan_Refill || code < 0) {
  344.         /* Make sure the array is clean for the GC. */
  345.         refset_null(pbs->bin_array.value.refs + pbs->index,
  346.                 arg - pbs->index);
  347.         pbs->cont = scan_bin_num_array_continue;
  348.         }
  349.         return code;
  350.     }
  351.     return_error(e_syntaxerror);
  352. }
  353.  
  354. /* Get a system or user name. */
  355. private int
  356. scan_bin_get_name(const ref *pnames /*t_array*/, int index, ref *pref)
  357. {
  358.     if (pnames == 0)
  359.     return_error(e_rangecheck);
  360.     return array_get(pnames, (long)index, pref);
  361. }
  362.  
  363. /* Continue collecting a binary string. */
  364. private int
  365. scan_bin_string_continue(i_ctx_t *i_ctx_p, stream * s, ref * pref,
  366.              scanner_state * pstate)
  367. {
  368.     byte *q = pstate->s_da.next;
  369.     uint wanted = pstate->s_da.limit - q;
  370.     uint rcnt;
  371.  
  372.     sgets(s, q, wanted, &rcnt);
  373.     if (rcnt == wanted) {
  374.     /* Finished collecting the string. */
  375.     make_string(pref, a_all | icurrent_space,
  376.             pstate->s_da.limit - pstate->s_da.base,
  377.             pstate->s_da.base);
  378.     return 0;
  379.     }
  380.     pstate->s_da.next = q + rcnt;
  381.     pstate->s_scan_type = scanning_binary;
  382.     return scan_Refill;
  383. }
  384.  
  385. /* Continue scanning a binary number array. */
  386. private int
  387. scan_bin_num_array_continue(i_ctx_t *i_ctx_p, stream * s, ref * pref,
  388.                 scanner_state * pstate)
  389. {
  390.     scan_binary_state *const pbs = &pstate->s_ss.binary;
  391.     uint index = pbs->index;
  392.     ref *np = pbs->bin_array.value.refs + index;
  393.     uint wanted = encoded_number_bytes(pbs->num_format);
  394.  
  395.     for (; index < r_size(&pbs->bin_array); index++, np++) {
  396.     int code;
  397.  
  398.     if (sbufavailable(s) < wanted) {
  399.         pbs->index = index;
  400.         pstate->s_scan_type = scanning_binary;
  401.         return scan_Refill;
  402.     }
  403.     code = sdecode_number(sbufptr(s), pbs->num_format, np);
  404.     switch (code) {
  405.         case t_integer:
  406.         case t_real:
  407.         r_set_type(np, code);
  408.         sbufskip(s, wanted);
  409.         break;
  410.         case t_null:
  411.         return_error(e_syntaxerror);
  412.         default:
  413.         return code;
  414.     }
  415.     }
  416.     *pref = pbs->bin_array;
  417.     return 0;
  418. }
  419.  
  420. /*
  421.  * Continue scanning a binary object sequence.  We preallocated space for
  422.  * the largest possible number of objects, but not for strings, since
  423.  * the latter would probably be a gross over-estimate.  Instead,
  424.  * we wait until we see the first string or name, and allocate string space
  425.  * based on the hope that its string index is the smallest one we will see.
  426.  * If this turns out to be wrong, we may have to reallocate, and adjust
  427.  * all the pointers.
  428.  */
  429. private int
  430. scan_bos_continue(i_ctx_t *i_ctx_p, register stream * s, ref * pref,
  431.           scanner_state * pstate)
  432. {
  433.     scan_binary_state *const pbs = &pstate->s_ss.binary;
  434.     s_declare_inline(s, p, rlimit);
  435.     uint max_array_index = pbs->max_array_index;
  436.     uint min_string_index = pbs->min_string_index;
  437.     int num_format = pbs->num_format;
  438.     uint index = pbs->index;
  439.     uint size = pbs->size;
  440.     ref *abase = pbs->bin_array.value.refs;
  441.     int code;
  442.  
  443.     pbs->cont = scan_bos_continue;  /* in case of premature return */
  444.     s_begin_inline(s, p, rlimit);
  445.     for (; index < max_array_index; p += SIZEOF_BIN_SEQ_OBJ, index++) {
  446.     ref *op = abase + index;
  447.     uint osize;
  448.     long value;
  449.     uint atype, attrs;
  450.  
  451.     s_end_inline(s, p, rlimit);    /* in case of error */
  452.     if (rlimit - p < SIZEOF_BIN_SEQ_OBJ) {
  453.         pbs->index = index;
  454.         pbs->max_array_index = max_array_index;
  455.         pbs->min_string_index = min_string_index;
  456.         pstate->s_scan_type = scanning_binary;
  457.         return scan_Refill;
  458.     }
  459.     if (p[2] != 0) /* reserved, must be 0 */
  460.         return_error(e_syntaxerror);
  461.     attrs = (p[1] & 128 ? a_executable : 0);
  462.     switch (p[1] & 0x7f) {
  463.         case BS_TYPE_NULL:
  464.         make_null(op);
  465.         break;
  466.         case BS_TYPE_INTEGER:
  467.         make_int(op, sdecodelong(p + 5, num_format));
  468.         break;
  469.         case BS_TYPE_REAL:{
  470.             float vreal;
  471.  
  472.             osize = sdecodeushort(p + 3, num_format);
  473.             if (osize != 0) {    /* fixed-point number */
  474.             value = sdecodelong(p + 5, num_format);
  475.             vreal = (float)ldexp((double)value, -osize);
  476.             } else {
  477.             vreal = sdecodefloat(p + 5, num_format);
  478.             }
  479.             make_real(op, vreal);
  480.             break;
  481.         }
  482.         case BS_TYPE_BOOLEAN:
  483.         make_bool(op, sdecodelong(p + 5, num_format) != 0);
  484.         break;
  485.         case BS_TYPE_STRING:
  486.         osize = sdecodeushort(p + 3, num_format);
  487.         attrs |= a_all;
  488.           str:
  489.         if (osize == 0) {
  490.             /* For zero-length strings, the offset */
  491.             /* doesn't matter, and may be zero. */
  492.             make_empty_string(op, attrs);
  493.             break;
  494.         }
  495.         value = sdecodelong(p + 5, num_format);
  496.         if (value < max_array_index * SIZEOF_BIN_SEQ_OBJ ||
  497.             value + osize > size
  498.             )
  499.             return_error(e_syntaxerror);
  500.         if (value < min_string_index) {
  501.             /* We have to (re)allocate the strings. */
  502.             uint str_size = size - value;
  503.             byte *sbase;
  504.  
  505.             if (pstate->s_da.is_dynamic)
  506.             sbase = scan_bos_resize(i_ctx_p, pstate, str_size,
  507.                         index);
  508.             else
  509.             sbase = ialloc_string(str_size,
  510.                           "bos strings");
  511.             if (sbase == 0)
  512.             return_error(e_VMerror);
  513.             pstate->s_da.is_dynamic = true;
  514.             pstate->s_da.base = pstate->s_da.next = sbase;
  515.             pstate->s_da.limit = sbase + str_size;
  516.             min_string_index = value;
  517.         }
  518.         make_string(op, attrs | icurrent_space, osize,
  519.                 pstate->s_da.base +
  520.                 (value - min_string_index));
  521.         break;
  522.         case BS_TYPE_EVAL_NAME:
  523.         attrs |= a_readonly;    /* mark as executable for later */
  524.         /* falls through */
  525.         case BS_TYPE_NAME:
  526.         osize = sdecodeushort(p + 3, num_format);
  527.         value = sdecodelong(p + 5, num_format);
  528.         switch (osize) {
  529.             case 0:
  530.             code = array_get(user_names_p, value, op);
  531.             goto usn;
  532.             case 0xffff:
  533.             code = array_get(system_names_p, value, op);
  534.               usn:
  535.             if (code < 0)
  536.                 return code;
  537.             if (!r_has_type(op, t_name))
  538.                 return_error(e_undefined);
  539.             r_set_attrs(op, attrs);
  540.             break;
  541.             default:
  542.             goto str;
  543.         }
  544.         break;
  545.         case BS_TYPE_ARRAY:
  546.         osize = sdecodeushort(p + 3, num_format);
  547.         atype = t_array;
  548.           arr:
  549.         value = sdecodelong(p + 5, num_format);
  550.         if (value + osize > min_string_index ||
  551.             value & (SIZEOF_BIN_SEQ_OBJ - 1)
  552.             )
  553.             return_error(e_syntaxerror);
  554.         {
  555.             uint aindex = value / SIZEOF_BIN_SEQ_OBJ;
  556.  
  557.             max_array_index =
  558.             max(max_array_index, aindex + osize);
  559.             make_tasv_new(op, atype,
  560.                   attrs | a_all | icurrent_space,
  561.                   osize, refs, abase + aindex);
  562.         }
  563.         break;
  564.         case BS_TYPE_DICTIONARY:    /* EXTENSION */
  565.         osize = sdecodeushort(p + 3, num_format);
  566.         if ((osize & 1) != 0 && osize != 1)
  567.             return_error(e_syntaxerror);
  568.         atype = t_mixedarray;    /* mark as dictionary */
  569.         goto arr;
  570.         case BS_TYPE_MARK:
  571.         make_mark(op);
  572.         break;
  573.         default:
  574.         return_error(e_syntaxerror);
  575.     }
  576.     }
  577.     s_end_inline(s, p, rlimit);
  578.     /* Shorten the objects to remove the space that turned out */
  579.     /* to be used for strings. */
  580.     pbs->index = max_array_index;
  581.     iresize_ref_array(&pbs->bin_array, max_array_index,
  582.               "binary object sequence(objects)");
  583.     code = scan_bos_string_continue(i_ctx_p, s, pref, pstate);
  584.     if (code == scan_Refill)
  585.     pbs->cont = scan_bos_string_continue;
  586.     return code;
  587. }
  588.  
  589. /* Reallocate the strings for a binary object sequence, */
  590. /* adjusting all the pointers to them from objects. */
  591. private byte *
  592. scan_bos_resize(i_ctx_t *i_ctx_p, scanner_state * pstate, uint new_size,
  593.         uint index)
  594. {
  595.     scan_binary_state *const pbs = &pstate->s_ss.binary;
  596.     uint old_size = da_size(&pstate->s_da);
  597.     byte *old_base = pstate->s_da.base;
  598.     byte *new_base = iresize_string(old_base, old_size, new_size,
  599.                     "scan_bos_resize");
  600.     byte *relocated_base = new_base + (new_size - old_size);
  601.     uint i;
  602.     ref *aptr = pbs->bin_array.value.refs;
  603.  
  604.     if (new_base == 0)
  605.     return 0;
  606.     /* Since the allocator normally extends strings downward, */
  607.     /* it's quite possible that new and old addresses are the same. */
  608.     if (relocated_base != old_base)
  609.     for (i = index; i != 0; i--, aptr++)
  610.         if (r_has_type(aptr, t_string) && r_size(aptr) != 0)
  611.         aptr->value.bytes =
  612.             aptr->value.bytes - old_base + relocated_base;
  613.     return new_base;
  614. }
  615.  
  616. /* Continue reading the strings for a binary object sequence. */
  617. private int
  618. scan_bos_string_continue(i_ctx_t *i_ctx_p, register stream * s, ref * pref,
  619.              scanner_state * pstate)
  620. {
  621.     scan_binary_state *const pbs = &pstate->s_ss.binary;
  622.     ref rstr;
  623.     ref *op = pbs->bin_array.value.refs;
  624.     int code = scan_bin_string_continue(i_ctx_p, s, &rstr, pstate);
  625.     uint space = ialloc_space(idmemory);
  626.     bool rescan = false;
  627.     uint i;
  628.  
  629.     if (code != 0)
  630.     return code;
  631.     /* Finally, fix up names and dictionaries. */
  632.     for (i = r_size(&pbs->bin_array); i != 0; i--, op++)
  633.     switch (r_type(op)) {
  634.         case t_string:
  635.         if (r_has_attr(op, a_write))    /* a real string */
  636.             break;
  637.         /* This is actually a name; look it up now. */
  638.         {
  639.             uint attrs =
  640.             (r_has_attr(op, a_executable) ? a_executable : 0);
  641.  
  642.             code = name_ref(op->value.bytes, r_size(op), op, 1);
  643.             if (code < 0)
  644.             return code;
  645.             r_set_attrs(op, attrs);
  646.         }
  647.         /* falls through */
  648.         case t_name:
  649.         if (r_has_attr(op, a_read)) {    /* BS_TYPE_EVAL_NAME */
  650.             ref *defp = dict_find_name(op);
  651.  
  652.             if (defp == 0)
  653.             return_error(e_undefined);
  654.             store_check_space(space, defp);
  655.             ref_assign(op, defp);
  656.         }
  657.         break;
  658.         case t_mixedarray:    /* actually a dictionary */
  659.         {
  660.             uint count = r_size(op);
  661.             ref rdict;
  662.  
  663.             if (count == 1) {
  664.             /* Indirect reference. */
  665.             if (op->value.refs < op)
  666.                 ref_assign(&rdict, op->value.refs);
  667.             else {
  668.                 rescan = true;
  669.                 continue;
  670.             }
  671.             } else {
  672.             code = dict_create(count >> 1, &rdict);
  673.             if (code < 0)
  674.                 return code;
  675.             while (count) {
  676.                 count -= 2;
  677.                 code = idict_put(&rdict,
  678.                         &op->value.refs[count],
  679.                         &op->value.refs[count + 1]);
  680.                 if (code < 0)
  681.                 return code;
  682.             }
  683.             }
  684.             r_set_attrs(&rdict, a_all);
  685.             r_copy_attrs(&rdict, a_executable, op);
  686.             ref_assign(op, &rdict);
  687.         }
  688.         break;
  689.     }
  690.     /* If there were any forward indirect references, */
  691.     /* fix them up now. */
  692.     if (rescan)
  693.     for (op = pbs->bin_array.value.refs, i = r_size(&pbs->bin_array);
  694.          i != 0; i--, op++
  695.         )
  696.         if (r_has_type(op, t_mixedarray)) {
  697.         const ref *piref = op->value.const_refs;
  698.         ref rdict;
  699.  
  700.         if (r_has_type(piref, t_mixedarray))    /* ref to indirect */
  701.             return_error(e_syntaxerror);
  702.         ref_assign(&rdict, piref);
  703.         r_copy_attrs(&rdict, a_executable, op);
  704.         ref_assign(op, &rdict);
  705.         }
  706.     ref_assign(pref, &pbs->bin_array);
  707.     r_set_size(pref, pbs->top_size);
  708.     return scan_BOS;
  709. }
  710.  
  711. /* ---------------- Writing ---------------- */
  712.  
  713. int
  714. encode_binary_token(i_ctx_t *i_ctx_p, const ref *obj, long *ref_offset,
  715.             long *char_offset, byte *str)
  716. {
  717.     bin_seq_type_t type;
  718.     uint size = 0;
  719.     long value;
  720.     ref nstr;
  721.  
  722.     switch (r_type(obj)) {
  723.     case t_null:
  724.         type = BS_TYPE_NULL;
  725.         goto tx;
  726.     case t_mark:
  727.         type = BS_TYPE_MARK;
  728.         goto tx;
  729.     case t_integer:
  730.         type = BS_TYPE_INTEGER;
  731.         value = obj->value.intval;
  732.         break;
  733.     case t_real:
  734.         type = BS_TYPE_REAL;
  735.         /***** DOESN'T HANDLE NON-IEEE NATIVE *****/
  736.         if (sizeof(obj->value.realval) == sizeof(int)) {
  737.         value = *(const int *)&obj->value.realval;
  738.         } else {
  739.         /****** CAN'T HANDLE IT ******/
  740.         return_error(e_rangecheck);
  741.         }
  742.         break;
  743.     case t_boolean:
  744.         type = BS_TYPE_BOOLEAN;
  745.         value = obj->value.boolval;
  746.         break;
  747.     case t_array:
  748.         type = BS_TYPE_ARRAY;
  749.         size = r_size(obj);
  750.         goto aod;
  751.     case t_dictionary:    /* EXTENSION */
  752.         type = BS_TYPE_DICTIONARY;
  753.         size = dict_length(obj) << 1;
  754.       aod:value = *ref_offset;
  755.         *ref_offset += size * (ulong) SIZEOF_BIN_SEQ_OBJ;
  756.         break;
  757.     case t_string:
  758.         type = BS_TYPE_STRING;
  759. nos:
  760.         size = r_size(obj);
  761.         value = *char_offset;
  762.         *char_offset += size;
  763.         break;
  764.     case t_name:
  765.         type = BS_TYPE_NAME;
  766.         name_string_ref(obj, &nstr);
  767.         r_copy_attrs(&nstr, a_executable, obj);
  768.         obj = &nstr;
  769.         goto nos;
  770.     default:
  771.         return_error(e_rangecheck);
  772.     }
  773.     {
  774.     byte s0 = (byte) size, s1 = (byte) (size >> 8);
  775.     byte v0 = (byte) value, v1 = (byte) (value >> 8), v2 = (byte) (value >> 16),
  776.          v3 = (byte) (value >> 24);
  777.     int order = (int)ref_binary_object_format.value.intval - 1;
  778.  
  779.     if (order & 1) {
  780.         /* Store little-endian */
  781.         str[2] = s0, str[3] = s1;
  782.         str[4] = v0, str[5] = v1, str[6] = v2, str[7] = v3;
  783.     } else {
  784.         /* Store big-endian */
  785.         str[2] = s1, str[3] = s0;
  786.         str[4] = v3, str[5] = v2, str[6] = v1, str[7] = v0;
  787.     }
  788.     }
  789. tx:
  790.     if (r_has_attr(obj, a_executable))
  791.     type += BS_EXECUTABLE;
  792.     str[0] = (byte) type;
  793.     return 0;
  794. }
  795.